home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / a_utils / ffccflow / ffccflow.lha / ffccc+flow / flow / protre.for < prev    next >
Encoding:
Text File  |  1992-07-31  |  7.6 KB  |  272 lines
  1.       SUBROUTINE PROTRE
  2. C! Produce the FLOW diagram
  3.       INCLUDE 'params.h'
  4.       INCLUDE 'tables.h'
  5.       INCLUDE 'lunits.h'
  6.       INCLUDE 'trecom.h'
  7.       INCLUDE 'ignore.h'
  8. C
  9.       CHARACTER*(MXCHR) CLINE,CTITL(MTITL),CLINO
  10.       CHARACTER*(MXNAM) CNAM,CNAM2,CNAME(MLEV,MNLEV)
  11.       CHARACTER*(LCDOIF) CDF,CDOIF(MLEV,MNLEV)
  12.       CHARACTER*1 CHAR
  13.       CHARACTER*(MXLIN) CFORM
  14.       INTEGER NDONE(MLEV),NMAX(MLEV),SEARCH
  15.       EXTERNAL SEARCH
  16.       LOGICAL OK
  17. C
  18. C statement function iposl
  19.       IPOSL(IL) = (MXOFF+NDIS)*(IL-1) + 1
  20. C
  21.       WRITE(LOUT,'(A)') ' '
  22.       WRITE(LOUT,'(A)') ' PROTRE Begins ....'
  23.       WRITE(LOUT,'(A)') ' '
  24. C
  25.       DO 5 IC=1,MXCHR
  26.         CLINO(IC:IC) = ' '
  27.    5  CONTINUE
  28. C
  29. C check for first procedure unknown
  30. C
  31.       IF(CTREE.EQ.'$$$$') CTREE = PROCED_NAME(1)
  32.       NSUBNM = 1
  33.       CSUBNM(1) = CTREE
  34.       CDF       = ' '
  35. C
  36.       IOFF = NDIS+MXOFF/2-2
  37. C
  38.       WRITE(LOUTRE,550)
  39.   550 FORMAT(1X,20('*'),'              ProTre             ',20('*'),
  40.      &     /,1X,20(' '),'              ======             ',20(' '),
  41.      &   ///,1X,20(' '),' Meaning of Symbols:                     ',
  42.      &     /,1X,20(' '),' -------------------                     ',
  43.      &    //,1X,20(' '),' .   ==> terminal node in the tree       ',
  44.      &     /,1X,20(' '),' *   ==> external procedure              ',
  45.      &     /,1X,20(' '),' >   ==> subtree node, expanded below    ',
  46.      &     /,1X,20(' '),' +   ==> multiply called terminal node   ',
  47.      &     /,1X,20(' '),' ]   ==> procedure calling only externals',
  48.      &     /,1X,20('-'),'---------------------------------',20('-'),
  49.      &     /,1X,20(' '),' ?   ==> module is in IF clause',
  50.      &     /,1X,20(' '),' (   ==> module is in DO loop',
  51.      &    //,1X,20('*'),'*********************************',20('*'))
  52. C
  53.       IF(.NOT.LEXT) WRITE(LOUTRE,551)
  54.   551 FORMAT(//,1X,'EXTERNAL procedure names will not appear ',/)
  55.       IF(NIGNO.NE.0) THEN
  56.          WRITE(LOUTRE,'(A)')
  57.      &   ' --------------------------------------------------'
  58.          WRITE(LOUTRE,'(1X,I5,A)') NIGNO,' Module(s) will be ignored :'
  59.          WRITE(LOUTRE,'(1X,6A8)') (CIGNO(IG),IG=1,NIGNO)
  60.          WRITE(LOUTRE,'(A,/)')
  61.      &   ' --------------------------------------------------'
  62.       ENDIF
  63. C
  64.   300 CONTINUE
  65.       IF(NSUBNM.LE.0) GOTO 40
  66.       CNAM = CSUBNM(1)
  67. C
  68. C IGNORE SPECIFIED MODULES
  69. C
  70.       DO 301 IG=1,NIGNO
  71.          IF(CNAM.EQ.CIGNO(IG)) GOTO 30
  72.   301 CONTINUE
  73. C
  74.       WRITE(LOUTRE,500) CNAM
  75.   500 FORMAT(/,1X,'=============',
  76.      &       /,1X,'Node name ==> ',A,
  77.      &       /,1X,'=============',/)
  78. C
  79.       DO 10 J=1,MLEV
  80.          NDONE(J) = 0
  81.          NMAX(J)  = 0
  82.          DO 10 I=1,MNLEV
  83.             CNAME(J,I) = ' '
  84.    10 CONTINUE
  85. C
  86.       ILEV = 1
  87.       INAM = 1
  88.       CNAME(ILEV,INAM) = CNAM
  89.       CLINE = CLINO
  90. C
  91. C pseudo-recursive tree search
  92. C
  93.    20 CONTINUE
  94. C
  95.       IPNAM = SEARCH(CNAM)
  96.       IF(IPNAM.EQ.0) GOTO 910
  97. C
  98. C compose leading line
  99. C
  100.       CLINE(:MXCHR) = CLINO(:MXCHR)
  101.       LENID = LENOCC(CDF)
  102.       DO 55 IL=ILEV,2,-1
  103.         IBEG = IPOSL(IL) - IOFF
  104.         IF(IL.EQ.ILEV) THEN
  105.           CLINE(IBEG:IBEG) = '|'
  106.           DO 56 IP=IBEG+1,IBEG+IOFF
  107.             IPL=IP-IBEG
  108.             IF(IPL.GT.LENID) CHAR = '-'
  109.             IF(IPL.LE.LENID) THEN
  110.               CHAR = CDF(IPL:IPL)
  111.               IF(IP.EQ.IBEG+IOFF) CHAR = '+'
  112.             ENDIF
  113.             CLINE(IP:IP) = CHAR
  114.    56     CONTINUE
  115.           GOTO 55
  116.         ENDIF
  117.         IF(NDONE(IL-1).GE.NMAX(IL-1)) GOTO 55
  118.         CLINE(IBEG:IBEG) = '|'
  119.    55 CONTINUE
  120. C
  121.       IF(PROCED_NCALLS(IPNAM).EQ.0) THEN
  122. C stub
  123.          CHAR = '.'
  124.          IF(PROCED_NCALLEDBY(IPNAM).GE.1) CHAR = '+'
  125.          IF(PROCED_EXTERN(IPNAM)) CHAR = '*'
  126.          CFORM = CLINE(:IPOSL(ILEV))//CNAM//' '//CHAR
  127.          LCOM = LENOCC(PROCED_DESCRIP(IPNAM))
  128.          LFOR = LENOCC(CFORM)
  129.          IF(LFOR.LT.LPSTA) THEN
  130.            CFORM(LFOR+1:LPSTA) = ' '
  131.            CFORM(LPSTA:LPSTA+1) = ': '
  132.            IF(LCOM.NE.0) THEN
  133.              CFORM(LPSTA+2:MXLIN) = PROCED_DESCRIP(IPNAM)(:LCOM)
  134.            ELSE
  135.              CFORM(LPSTA+2:MXLIN) = ' '
  136.            ENDIF
  137.          ENDIF
  138.          WRITE(LOUTRE,'(1X,A)') CFORM
  139.          GOTO 45
  140.       ELSE IF(PROCED_NCALLS(IPNAM).GT.0) THEN
  141. C multiple call (general case)
  142.         IOK = 0
  143.         DO 73 IC=1,PROCED_NCALLS(IPNAM)
  144.            IF(.NOT.PROCED_EXTERN(PROCED_CALLS(IPNAM,IC))) IOK = 1
  145.    73   CONTINUE
  146.         IF(NDONE(ILEV).EQ.0) THEN
  147.           CHAR = ' '
  148.           IF(PROCED_NCALLEDBY(IPNAM).GT.1) THEN
  149. C
  150. C sub tree ... check if this pass is for expansion
  151. C
  152.             IFOUN = 0
  153.             IF(ILEV.EQ.1) THEN
  154.               CHAR = ' '
  155.               DO 66 IS=1,NSUBNM
  156.                 IF(CNAM.EQ.CSUBNM(IS)) THEN
  157.                   LSUBNM(IS) = .TRUE.
  158.                   IFOUN = IS
  159.                 ENDIF
  160.    66         CONTINUE
  161.             ELSE
  162.               CHAR = '>'
  163.             ENDIF
  164.           ENDIF
  165.           IF(IOK.EQ.0) CHAR = ']'
  166.           CFORM = CLINE(:IPOSL(ILEV))//CNAM//' '//CHAR
  167.           LCOM = LENOCC(PROCED_DESCRIP(IPNAM))
  168.           LFOR = LENOCC(CFORM)
  169.           IF(LFOR.LT.LPSTA) THEN
  170.              CFORM(LFOR+1:LPSTA) = ' '
  171.              CFORM(LPSTA:LPSTA+1) = ': '
  172.              IF(LCOM.GT.0) THEN
  173.                 CFORM(LPSTA+2:MXLIN) = PROCED_DESCRIP(IPNAM)(:LCOM)
  174.              ELSE
  175.                 CFORM(LPSTA+2:MXLIN) = ' '
  176.              ENDIF
  177.           ENDIF
  178.           WRITE(LOUTRE,'(1X,A)') CFORM
  179.           IF(PROCED_NCALLEDBY(IPNAM).GT.1.AND.IFOUN.EQ.0) THEN
  180. C
  181. C sub tree which will be expanded later. add to name list
  182. C (but only if not already there).
  183. C
  184.             DO 67 IS=1,NSUBNM
  185.                IF(CNAM.EQ.CSUBNM(IS)) GOTO 45
  186.    67       CONTINUE
  187.             IF(NSUBNM.GE.MSUBT) THEN
  188.                WRITE(LOUT,'(A,I6,A)') ' Max of ',MSUBT,
  189.      &                    ' sub-trees exceeded'
  190.                GOTO 45
  191.             ENDIF
  192. C
  193. C IGNORE EXTERNALS, IF THAT IS REQUIRED
  194. C
  195.             IF(.NOT.LEXT.AND.IOK.EQ.0) GOTO 45
  196.             NSUBNM = NSUBNM + 1
  197.             CSUBNM(NSUBNM) = CNAM
  198.             LSUBNM(NSUBNM) = .FALSE.
  199.             GOTO 45
  200.           ENDIF
  201.         ENDIF
  202. C
  203. C fill all names at this level
  204. C
  205.         IF(NDONE(ILEV).EQ.0) THEN
  206.           NC = 0
  207.           DO 36 IN=1,PROCED_NCALLS(IPNAM)
  208.              IPNAM2 = PROCED_CALLS(IPNAM,IN)
  209. C
  210. C IGNORE EXTERNALS IF REQUIRED
  211. C
  212.              IF(.NOT.LEXT.AND.PROCED_EXTERN(IPNAM2)) GOTO 36
  213.              NC = NC + 1
  214.              CNAME(ILEV,NC) = PROCED_NAME(IPNAM2)
  215.              CDOIF(ILEV,NC)(:LCDOIF) = PROCED_DOIF(IPNAM,IN)(:LCDOIF)
  216.    36     CONTINUE
  217.           NMAX(ILEV) = NC 
  218.         ENDIF
  219.         GOTO 46
  220.       ENDIF
  221.    45 CONTINUE
  222. C
  223. C end of level. move up one
  224. C
  225.       ILEV = ILEV - 1
  226.       IF(ILEV.EQ.0) GOTO 30
  227.    46 CONTINUE
  228.       IF(NDONE(ILEV).GE.NMAX(ILEV)) THEN
  229.         NDONE(ILEV) = 0
  230.         GOTO 45
  231.       ENDIF
  232.       CNAM = CNAME(ILEV,NDONE(ILEV)+1)
  233.       CDF(:LCDOIF)  = CDOIF(ILEV,NDONE(ILEV)+1)(:LCDOIF)
  234.       NDONE(ILEV) = NDONE(ILEV) + 1
  235.       ILEV = ILEV + 1
  236.       GOTO 20
  237.    30 CONTINUE
  238. C
  239. C end of this tree. shift names in sub-tre list and start again
  240. C
  241.         DO 72 I=1,NSUBNM-1
  242.           LSUBNM(I) = LSUBNM(I+1)
  243.           CSUBNM(I) = CSUBNM(I+1)
  244.   72    CONTINUE
  245.         NSUBNM = NSUBNM - 1
  246.       IPOIN = 0
  247.    35 IPOIN = IPOIN + 1
  248.       IF(IPOIN.GT.NSUBNM) GOTO 300
  249.       IF(LSUBNM(IPOIN)) THEN
  250.         DO 71 I=IPOIN,NSUBNM-1
  251.           LSUBNM(I) = LSUBNM(I+1)
  252.           CSUBNM(I) = CSUBNM(I+1)
  253.   71    CONTINUE
  254.         NSUBNM = NSUBNM - 1
  255.         IPOIN = IPOIN - 1
  256.       ENDIF
  257.       GOTO 35
  258. C
  259.    40 CONTINUE
  260. C
  261. C finished all trees. home to beddy-bies
  262. C
  263.       WRITE(LOUT,'(A)') ' PROTRE Finished'
  264.       IERROR = 0
  265.       GOTO 999
  266.   910 WRITE(LOUTRE,911) CNAM
  267.       WRITE(LOUT,911) CNAM
  268.   911 FORMAT(1X,'PROTRE --> ROUTINE:',A,' NOT FOUND IN PROCEDURE TABLE')
  269.       IERROR = 2
  270.   999 CONTINUE
  271.       END
  272.